home *** CD-ROM | disk | FTP | other *** search
/ PC Users 1998 June / Cd Pc Users 9.iso / prog / inst / cddetect / detectcd.frm (.txt) next >
Encoding:
Visual Basic Form  |  1997-09-02  |  3.7 KB  |  108 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "CD-ROM DETECTION"
  5.    ClientHeight    =   480
  6.    ClientLeft      =   2070
  7.    ClientTop       =   3180
  8.    ClientWidth     =   5115
  9.    Height          =   885
  10.    Left            =   2010
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   480
  15.    ScaleWidth      =   5115
  16.    ShowInTaskbar   =   0   'False
  17.    Top             =   2835
  18.    Width           =   5235
  19.    Begin VB.Label Label1 
  20.       Alignment       =   2  'Center
  21.       Height          =   255
  22.       Left            =   0
  23.       TabIndex        =   0
  24.       Top             =   120
  25.       Width           =   5055
  26.    End
  27. Attribute VB_Name = "Form1"
  28. Attribute VB_Creatable = False
  29. Attribute VB_Exposed = False
  30. Option Explicit
  31. Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
  32. Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
  33. Private Const DRIVE_REMOVABLE = 2
  34. Private Const DRIVE_FIXED = 3
  35. Private Const DRIVE_REMOTE = 4
  36. Private Const DRIVE_CDROM = 5
  37. Private Const DRIVE_RAMDISK = 6
  38. Function StripNulls(startStrg$) As String
  39. 'Take a string separated by Chr$(0)'s, and split off 1 item, and
  40. 'shorten the string so that the next item is ready for removal.
  41.   Dim c%, item$
  42.   c% = 1
  43.     If Mid$(startStrg$, c%, 1) = Chr$(0) Then
  44.       
  45.       item$ = Mid$(startStrg$, 1, c% - 1)
  46.       startStrg$ = Mid$(startStrg$, c% + 1, Len(startStrg$))
  47.       StripNulls$ = item$
  48.       Exit Function
  49.     End If
  50.     c% = c% + 1
  51.   Loop
  52. End Function
  53. Private Sub Form_Load()
  54. '****************************************************
  55. 'This file was corrected and passed trought:
  56. 'K.Driblinov page... tons of C & Vb sources, links to other prg sites!!
  57. 'http://www.geocities.com/SiliconValley/Lakes/7057
  58. 'E-Mail: kdriblinov@hotmail.com
  59. '****************************************************
  60. Dim r&, allDrives$, JustOneDrive$, pos%, DriveType&
  61. Dim CDfound As Integer
  62.   'pad the string with spaces
  63.    allDrives$ = Space$(64)
  64.   'call the API to get the string containing all drives
  65.    r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)
  66.   'trim off trailing chr$(0)'s.  AllDrives$
  67.   'now contains all the drive letters.
  68.    allDrives$ = Left$(allDrives$, r&)
  69.   'begin a loop
  70.    Do
  71.       
  72.      'find the first separating chr$(0)
  73.       pos% = InStr(allDrives$, Chr$(0))
  74.       
  75.      'if there's one, then...
  76.       If pos% Then
  77.         
  78.        'extract the drive up to the chr$(0)
  79.         JustOneDrive$ = Left$(allDrives$, pos%)
  80.         
  81.        'and remove that from the Alldrives string,
  82.        'so it won't be checked again
  83.         allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))
  84.       
  85.        'with the one drive, call the API to
  86.        'determine the drive type
  87.         DriveType& = GetDriveType(JustOneDrive$)
  88.         
  89.        'check if it's what we want
  90.         If DriveType& = DRIVE_CDROM Then
  91.           
  92.           'got it (or at least the first one,
  93.           'anyway, if more than one), so set
  94.           'the found flag...
  95.            CDfound% = True
  96.           'we're done, so get out
  97.            Exit Do
  98.         
  99.         End If
  100.       End If
  101.   Loop Until allDrives$ = "" Or DriveType& = DRIVE_CDROM
  102.  'display the appropriate message
  103.   If CDfound% Then
  104.         label1 = "The CD-ROM drive on your system is drive " & UCase$(JustOneDrive$)
  105.   Else: label1 = "No CD-ROM drives were detected on your system."
  106.   End If
  107. End Sub
  108.